home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
ada
/
gwuada_9.zip
/
PREDEF5.C
< prev
next >
Wrap
C/C++ Source or Header
|
1993-07-27
|
28KB
|
1,093 lines
/*
* Copyright (C) 1985-1992 New York University
*
* This file is part of the Ada/Ed-C system. See the Ada/Ed README file for
* warranty (none) and distribution info and also the GNU General Public
* License for more details.
*/
/* +---------------------------------------------------+
| |
| I N T E R P P R E D E F S |
| Part 5: TEXT_IO Scan Procedures |
| (C Version) |
| |
| Adapted From Low Level SETL version written by |
| |
| Monte Zweben |
| Philippe Kruchten |
| Jean-Pierre Rosen |
| |
| Original High Level SETL version written by |
| |
| Clint Goss |
| Tracey M. Siesser |
| Bernard D. Banner |
| Stephen C. Bryant |
| Gerry Fisher |
| |
| C version written by |
| |
| Robert B. K. Dewar |
| |
+---------------------------------------------------+
*/
/* This module contains routines for the implementation of some of
* the predefined Ada packages and routines, namely SEQUENTIAL_IO,
* DIRECT_IO, TEXT_IO, and CALENDAR. Part 5 contains the scanning
* procedures used for TEXT_IO input.
*/
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include "ipredef.h"
#include "machinep.h"
#include "predefp.h"
static char getcp();
static char nextc();
static void skipc();
static void copyc();
static void copy_integer();
static void copy_based_integer();
static void scan_blanks();
static void setup_fixed_field(int);
static void test_fixed_field_end();
static int alpha(char);
static int alphanum(char);
static int graphic(char);
static int digit(char);
static int extended_digit(char);
static int sign(char);
static void check_digit();
static void check_hash(char);
static void check_extended_digit();
static void range();
static int scan_int();
static int scan_based_int(int);
static double scan_real_val(int);
static void scan_enum_val();
static int scan_integer_val(int *, int);
static long scan_fixed_val(int *, int);
static float scan_float_val(int *, int);
/* The following variables control whether we are scanning from a file or
* from a string. The flag scan_mode is 'F' if scanning from a file and 'S'
* if scanning from a string. The pointer ins points to the next character
* to be scanned in the case where we are scanning from a string.
*/
static char scan_mode;
static char *ins;
/* The variable s is used to store characters in work_string */
static char *s;
/* GETCP */
/* This procedure gets the next character from the string or file being scanned
* according to the setting of scan_mode. In string mode, ins is updated. If no
* more character remain to be scanned, then END error is signalled.
*/
static char getcp() /*;getcp*/
{
if (scan_mode == 'F') {
return get_char();
}
else {
if (*ins == 0)
predef_raise(END_ERROR, "End of string encountered");
return * ins++;
}
}
/* NEXTC */
/* This procedure returns the next character to be read from the string or file
* being scanned, according to the setting of scan_mode. In string mode, ins is
* updated. If we are currently at end of string then a line feed is returned.
*/
static char nextc() /*;nextc*/
{
if (scan_mode == 'F') {
load_look_ahead(FALSE);
return CHAR1;
}
else {
if (*ins) return *ins;
else return LINE_FEED;
}
}
/* SKIPC */
/* This procedure skips the next input character */
static void skipc() /*;skipc*/
{
char c;
if (scan_mode == 'F')
c = get_char();
else
ins++;
}
/* COPYC */
/* This procedure copies the next input character to work_string using s */
static void copyc() /*;copyc*/
{
char c;
if (scan_mode == 'F')
c = get_char();
else
c = *ins++;
if (c)
*s++ = UPPER_CASE(c);
else
predef_raise (SYSTEM_ERROR, "End of string encountered");
}
/* COPY_INTEGER */
/* This procedure copies a string with the syntax of "integer" from the
* input to the work string. Underscores are allowed but not copied.
*/
static void copy_integer() /*;copy_integer*/
{
check_digit();
while (digit(nextc())) {
copyc();
if (nextc() == '_') {
skipc();
check_digit();
}
}
}
/* COPY_BASED_INTEGER */
/* This procedure copies a string with the syntax of "based_integer" from
* the input to the work string. Underscores are allowed but not copied.
*/
static void copy_based_integer() /*;copy_based_integer*/
{
check_extended_digit();
while (extended_digit(nextc())) {
copyc();
if (nextc() == '_') {
skipc();
check_extended_digit();
}
}
}
/* SCAN_BLANKS */
/* Routine to scan past leading blanks to find first non-blank. Signals
* an exception if no non-blank character is located.
*/
static void scan_blanks() /*;scan_blanks*/
{
char c;
if (scan_mode == 'F') {
for (;;) {
load_look_ahead(FALSE);
if (CHARS == 0)
predef_raise(END_ERROR, "No item found");
c = nextc();
if (c == ' ' || c == HT || c == PAGE_MARK || c == LINE_FEED)
getcp();
else break;
}
return;
}
else {
while(*ins == ' ' || *ins == HT) ins++;
return;
}
}
/* SETUP_FIXED_FIELD */
/* This procedure is used for numeric conversions where the field to be scanned
* has a fixed width(i.e. width parameter is non-zero). It acquires the field
* from the input file and copies it to work_string. It returns to the caller
* ready to scan the data from work_string.
*/
static void setup_fixed_field(int width) /*;setup_fixed_field*/
{
char *p;
p = work_string;
for (;;) {
load_look_ahead(FALSE);
if (width-- != 0 && CHARS != 0 && CHAR1 != PAGE_MARK
&& CHAR1 != LINE_FEED) {
*p++ = get_char();
}
else break;
}
*p = '\0';
scan_mode = 'S';
ins = work_string;
}
/* TEST_FIXED_FIELD_END */
/* This procedure is called after scanning an item from a fixed length field
* to ensure that only blanks remain in the field. An exception is raised if
* there are any unexpected non-blank characters left in the field.
*/
static void test_fixed_field_end() /*;test_fixed_field_end*/
{
scan_blanks();
if (*ins)
predef_raise(data_exception,"Unexpected non-blank characters in field");
}
/* ALPHA */
/* Procedure to test if character argument is an upper or lower case letter,
* returns TRUE if the argument is a letter, FALSE if it is not.
*/
static int alpha(char c) /*;alpha*/
{
if (c > 'Z')
c -= 32;
return ('A' <= c && c <= 'Z');
}
/* ALPHANUM */
/* Procedure to test if character argument is an upper or lower case letter,
* or a digit. Returns TRUE if the argument is a letter or digit, else FALSE.
*/
static int alphanum(char c) /*;alphanum*/
{
if (c > 'Z')
c -= 32;
return (('A' <= c && c <= 'Z') ||('0' <= c && c <= '9'));
}
/* GRAPHIC */
/* Procedure to test if character is an ASCII graphic character. Returns
* Returns TRUE if the argument is an ASCII graphic, else FALSE.
*/
static int graphic(char c) /*;graphic*/
{
return (0x20 <= c && c <= 0x7f);
}
/* DIGIT */
/* Procedure to test if character is a digit, returns TRUE or FALSE */
static int digit(char c) /*;digit*/
{
return ('0' <= c && c <= '9');
}
/* EXTENDED_DIGIT */
/* Procedu